home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_rawkey < prev    next >
Encoding:
Text File  |  1991-12-30  |  2.8 KB  |  153 lines
  1. \ Test RAWKeyConvert()
  2. \ Minimal call by opening Console Device
  3. \
  4. \ For more advanced usage, see ju:ConsoleSupport
  5. \
  6. \ Author: Phil Burk
  7. \ Copyright 1991  Delta Research
  8.  
  9. getmodule includes
  10. include? OpenDevice() ju:Exec_Support
  11. include? newwindow.setup ju:amiga_graph
  12. include? isprint ju:char-macros
  13. \ include? ev.getclass ju:amiga_events
  14. include? { ju:locals
  15.  
  16. ANEW TASK-DEMO_RAWKEY
  17.  
  18. decimal
  19. IORequest RKC-IORQ
  20.  
  21. : OPEN.CONSOLE ( -- device | 0 , open console device for CALL )
  22.     console_lib @ 0=
  23.     IF
  24.         0" console.device"
  25.         -1 \ for just getting device address
  26.         rkc-iorq
  27.         0
  28.         OpenDevice() ?dup
  29.         IF
  30.             ." OPEN.CONSOLE - Error = " . cr
  31.             0
  32.         ELSE
  33.             rkc-iorq ..@ io_device
  34.             dup console_lib !
  35.             if>rel
  36.         THEN
  37.     ELSE
  38.         console_lib @
  39.     THEN
  40. ;
  41.  
  42. : CLOSE.CONSOLE ( -- )
  43.     console_lib @
  44.     IF
  45.         rkc-iorq CloseDevice()
  46.         console_lib off
  47.     THEN
  48. ;
  49.  
  50. InputEvent FakeEvt
  51.  
  52. : RAW.KEY.CONVERT  ( code qualifier buffer -- nchars )
  53.     >r  \ save buffer
  54.     console_lib @ 0=
  55.     abort" RAW.KEY.CONVERT - OPEN.CONSOLE must be called first!"
  56. \
  57. \ setup fake input event
  58.     0 FakeEvt ..! ie_NextEvent
  59.     IECLASS_RAWKEY FakeEvt ..! ie_Class
  60. \
  61. \ use input parameters
  62.     FakeEvt ..! ie_Qualifier
  63.     FakeEvt ..! ie_Code
  64. \
  65.     FakeEvt >abs
  66.     r> >abs 32 0
  67.     call console_lib RawKeyConvert
  68. ;
  69.  
  70. NewWindow RawKeyWindow   ( Create a template for the new window. )
  71.  
  72. : DRK.PROCESS.EVENT { class | done? -- done? , process events from IDCMP }
  73.     false -> done?
  74.     class
  75.     CASE 
  76.         RAWKEY OF   ( check for up or down )
  77.             ev-last-Code @
  78.             ev-last-Qualifier @
  79.             pad raw.key.convert
  80. \
  81. \ print result
  82.             ." ----------------------" cr
  83.             dup 0>
  84.             IF
  85.                 ." Chars = " dup 0 DO pad i + c@ .hex LOOP cr
  86.                 ." Chars = " 0
  87.                 DO pad i + c@ dup isprint
  88.                     IF emit
  89.                     ELSE drop ." ."
  90.                     THEN 2 spaces
  91.                 LOOP cr
  92.             ELSE
  93.                 drop ." None .. key up or SHIFT or ?" cr
  94.             THEN
  95.         ENDOF
  96.  
  97.         CLOSEWINDOW OF true -> done? ENDOF
  98.  
  99.     ENDCASE
  100.     done?
  101. ;
  102.  
  103. : RawKey.LOOP  ( -- , loop until done )
  104.     BEGIN
  105.         gr-curwindow @ ev.wait
  106.         gr-curwindow @ ev.getclass ?dup
  107.         IF
  108.             drk.process.event
  109.         ELSE
  110.             false
  111.         THEN
  112.         ?terminal OR
  113.     UNTIL
  114. ;
  115.  
  116. : DRK.INIT ( -- ok? )
  117.     gr.init
  118.     open.console
  119.     IF
  120.         RawKeyWindow NewWindow.Setup      ( Set defaults for window )
  121.         140 RawKeyWindow s! nw_width
  122.         60 RawKeyWindow s! nw_height
  123.         0" RawKey - JForth" RawKeyWindow s! nw_title
  124.         CLOSEWINDOW RAWKEY |   ( add RAWKEY )
  125.             RawKeyWindow ..! nw_idcmpflags
  126.         RawKeyWindow s@ nw_flags ACTIVATE |
  127.             RawKeyWindow s! nw_flags
  128. \
  129. \ Create window from template and make it the current window.
  130.         RawKeyWindow gr.opencurw
  131.     ELSE
  132.         false
  133.     THEN
  134. ;
  135.  
  136. : DRK.TERM
  137.     gr.closecurw
  138.     close.console
  139.     gr.term
  140. ;
  141.  
  142. : DEMO.RAWKEY  ( -- , Demonstrate Raw Key )
  143.     drk.init
  144.     IF
  145.         cr ." Hit various keys including ARROWS and FUNCTION keys" cr
  146.         RawKey.LOOP
  147.     THEN
  148.     drk.term
  149. ;
  150.  
  151. cr ." Enter:   DEMO.RawKey     for demo!" cr
  152.  
  153.